home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / lysrc.zip / LEXMSGS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-24  |  4KB  |  137 lines
  1.  
  2. unit LexMsgs;
  3.  
  4. (* 2-5-91 AG *)
  5.  
  6. (* Copyright (c) 1990,91 by Albert Graef, Schillerstr. 18,
  7.    6509 Schornsheim/Germany
  8.    All rights reserved *)
  9.  
  10. interface
  11.  
  12. (* TP Lex message and error handling module
  13.    Note: this module should be USEd by any module using the heap during
  14.          initialization, since it installs a heap error handler (which
  15.          terminates the program with fatal error `memory overflow'). *)
  16.  
  17. var errors, warnings : Integer;
  18.   (* - current error and warning count *)
  19. procedure error(msg : String; pos : Integer);
  20.   (* - print current input line and error message (pos denotes position to
  21.        mark in source file line) *)
  22. procedure warning(msg : String; pos : Integer);
  23.   (* - print warning message *)
  24. procedure fatal(msg : String);
  25.   (* - writes a fatal error message, erases Lex output file and terminates
  26.        the program with errorlevel 1 *)
  27.  
  28. const
  29.  
  30. (* sign-on and usage message: *)
  31.  
  32. sign_on = 'TP Lex Version 3.0a [May 92], Copyright (c) 1990-92 Albert Graef';
  33. usage   = 'Usage: LEX [options] lex-file[.L] [output-file[.PAS]]';
  34. options = 'Options: /v verbose, /o optimize';
  35.  
  36. (* command line error messages: *)
  37.  
  38. invalid_option                  = 'invalid option ';
  39. illegal_no_args                 = 'illegal number of parameters';
  40.  
  41. (* syntax errors: *)
  42.  
  43. unmatched_lbrace                = '101: unmatched %{';
  44. syntax_error             = '102: syntax error';
  45. unexpected_eof                  = '103: unexpected end of file';
  46.  
  47. (* semantic errors: *)
  48.  
  49. symbol_already_defined         = '201: symbol already defined';
  50. undefined_symbol                = '202: undefined symbol';
  51. invalid_charnum                 = '203: invalid character number';
  52. empty_grammar             = '204: empty grammar?';
  53.  
  54. (* fatal errors: *)
  55.  
  56. cannot_open_file         = 'FATAL: cannot open file ';
  57. write_error                     = 'FATAL: write error';
  58. mem_overflow             = 'FATAL: memory overflow';
  59. intset_overflow         = 'FATAL: integer set overflow';
  60. sym_table_overflow         = 'FATAL: symbol table overflow';
  61. pos_table_overflow         = 'FATAL: position table overflow';
  62. state_table_overflow         = 'FATAL: state table overflow';
  63. trans_table_overflow         = 'FATAL: transition table overflow';
  64. macro_stack_overflow         = 'FATAL: macro stack overflow';
  65.  
  66. implementation
  67.  
  68. uses LexBase;
  69.  
  70. procedure position(var f : Text;
  71.             lineNo : integer;
  72.             line : String;
  73.             pos : integer);
  74.   (* writes a position mark of the form
  75.      gfilename (lineno): line
  76.                           ^
  77.      on f with the caret ^ positioned at pos in line
  78.      a subsequent write starts at the next line, indented with tab *)
  79.   var
  80.     line1, line2 : String;
  81.   begin
  82.     (* this hack handles tab characters in line: *)
  83.     line1 := intStr(lineNo)+': '+line;
  84.     line2 := blankStr(intStr(lineNo)+': '+copy(line, 1, pos-1));
  85.     writeln(f, line1);
  86.     writeln(f, line2, '^');
  87.     write(f, tab)
  88.   end(*position*);
  89.  
  90. procedure error(msg : String; pos : Integer);
  91.   begin
  92.     inc(errors);
  93.     writeln;
  94.     position(output, lno, line, pos);
  95.     writeln(msg);
  96.     writeln(yylst);
  97.     position(yylst, lno, line, pos);
  98.     writeln(yylst, msg);
  99.     if ioresult<>0 then ;
  100.   end(*error*);
  101.  
  102. procedure warning(msg : String; pos : Integer);
  103.   begin
  104.     inc(warnings);
  105.     writeln;
  106.     position(output, lno, line, pos);
  107.     writeln(msg);
  108.     writeln(yylst);
  109.     position(yylst, lno, line, pos);
  110.     writeln(yylst, msg);
  111.     if ioresult<>0 then ;
  112.   end(*warning*);
  113.  
  114. procedure fatal(msg : String);
  115.   begin
  116.     writeln;
  117.     writeln(msg);
  118.     close(yyin); close(yyout); close(yylst); erase(yyout);
  119.     halt(1)
  120.   end(*fatal*);
  121.  
  122. {$F+}
  123. function heapErrorHandler ( size : Word ): Integer;
  124. {$F-}
  125.   begin
  126.     if size>0 then
  127.       fatal(mem_overflow) (* never returns *)
  128.     else
  129.       heapErrorHandler := 1
  130.   end(*heapErrorHandler*);
  131.  
  132. begin
  133.   errors := 0; warnings := 0;
  134.   (* install heap error handler: *)
  135.   heapError := @heapErrorHandler;
  136. end(*LexMsgs*).
  137.